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COPYRIGHT (c) 1978, 1980, 1982, 1984 B 
DIGITAL EQUIPMENT CORPORATION, MAYNARD. MASSACHUSETTS. 
ALL RIGHTS RESERVED. 


THIS SOFTWARE 4 ait “mt A LICENSE AND MAY BE USED AND oo ace 
ONLY IN ACCORDANCE WITH THE yee ar OF SUCH TTS AND WITH THE 
OTICE. A SOFTWARE OR ANY OTHER 
VIDED OR OTHERWISE MADE AVAILABLE TO ANY 
OTHER PERSON. NO TITLE TO AND CHNERSHIP OF THE SOFTWARE IS HEREBY 
TRANSFERRED. 


THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
CORPORATION. NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 


DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR _ RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


LR ERRATA EERE EEE EEE EEE EEE EERE EEE 
‘ 


FACILITY: Pascal Language Support 


! ABSTRACT: 


This module contains PASSREWRITE2, which implements the 
VAX-11 Pascal REWRITE procedure. 


i ENVIRONMENT: User mode - AST reentrant 


i AUTHOR: Steven B. Lionel, CREATION DATE: 1-April-1981 


3 MODIFIED BY: 


le: PASREWRIT.B32 Edit: SBL1004 
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-001 - Original. SBL 1- tbh 1981 

-002 - Set FABSV_TEF if $STRUNCATE successful on sequential files. SBL 8-July-1982 
-003 - Don't SREQIND, etc., unless file is a disk or tape. SBL 29-July-1982 
1-004 - Clear RABSV_NLK. SBL 8-Apr-1983 
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= REWRITE procedure 


ZSBITL ‘PASSREWRITE2 = REWRITE procedure’ 
GLOBAL ROUTINE PASSREWRITE2 ( 
PFV: REF $PASSPFV_FILE_VARIABLE, 


ERROR 
): NOVALUE = 


+e 
FUNCTIONAL DESCRIPTION: 


3 1 
16-Sep-19 
14-Sep-19 


Be 98:51:55 


AX-11 Bliss-32 
PASRTL. RCIPAS 


! Do a REWRITE 
! File variable 
! Error unwind address 


PASSREWRITE2 implements the VAX-11 Pascal REWRITE procedure. It 


opens the fi 
and enters Generation mode. 


: CALLING SEQUENCE: 


CALL PASSREWRITE2 (PFV.mr.r C, ERROR.j.rJ) 


! FORMAL PARAMETERS: 


le if not already open, deletes all data from the file, 


PFV - The Pascal File Variable (PFV) passed Oy reper geet 


ERROR - Optional. 


case of an error. 
IMPLICIT INPUTS: 


' 
i 
i 
i 
i 
' 
i 
i 
' 
i 
' 
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i 
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' 
IMPLICIT OUTPUTS: 
' 
i 
i 
i 
! 
i 
i 
i 
i 
' 
i 
' 
i 
i 
i 
i 
i 
i 
' 
ie 


The structure of the PFV is defined in 


SPFV.REQ. 


If specified, the address to unwind to in 


NONE 
NONE 
ROUTINE VALUE: 
NONE 
SIDE EFFECTS: 
Throws away partial Line, if any. 
Deletes all data from the file. 
Positions to the beginning of the file. 
Enters Generation mode. 
SIGNALLED ERRORS: 
REWNOTALL - REWRITE not allowed without exclusive access 
ERRDURREW - error during REWRITE 
GENNOTALL - Generation mode not allowed 
BEGIN 
LOC 


AL 
FCB: REF $SPAS$FCB_CONTROL_BLOCK, 
PFV_ADDR: VOLATILE, 


' File control block 
! Enable argument 
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0-74 
RTT 882;1 (3) 


UNWIND_ACT: VOLATILE, ! Enable argument 
ERROR_ADDR: VOLATILE; ! Enable argument 
BIND 
RAB = FCB: REF BLOCK C, BYTE) ! RAB is also FCB address 
FAB = FCB: REF $PASSFAB_FCB_STRUCT, i FAB is based on FCB 
NAM = FCB: REF SPASSNAM_FCB_STRUCT; ! NAM is based on FCB 
BUILTIN 
ACTUALCOUNT, 
TESTBITSS; 
ENABLE 
PASSSIO_HANDLER (PFV_ADDR, UNWIND_ACT, ERROR_ADDR); ! Enable error handler 
IF ACTUALCOUNT () GEQU 2 
ERROR_ADDR = .ERROR; ! Set unwind address 


14+ 
Set enable argument for PFV address. 


PFV_ADDR = PFV CPFVSR_PFV]; | 
'¢ 

Validate and lock PFV. 
PASSSVALIDATE_PFV (PFV CPFV$R_PFVI]; FCB); 
'+ 


: Set unwind action to unlock file. 


_UNWIND_ACT = PASS$K_UNWIND_UNLOCK; 


'¢ 
Open file if it should be implicitly opened. 


co" -PFV CPFVS$V_VALIDJ 
PASSSOPEN_IMPLICIT (PFV CPFV$R_PFV], FCB CFCBSR_FCB); FCB); 


'¢ 
See if the file is open. If not, open it. 
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Yi a -PFV CPFV$V_OPEN] ! Not open 
PASSSOPEN (PFV CPFVSR_PFV], PASSK_HISTORY_NEW; FCB); 


'¢ 
If the file has the NOWRITE attribute, signal an error. 
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1-004 PASSREWRITE2 = REWRITE procedure 12-8 08- 1 3b 93:97:88 PASRTL.SRCJPASREWRIT.B32;1 . (33 7” 
; 138 0 i If .FCB CFCBSV_NOWRITE) ; 
: Hb 6 2B SPASSIO_ERROR (PAS$_GENNOTALL,O); ! Generation mode not allowed ; 
200 0261 r 
; 201 0 86 ! If a textfile, and if in Generation mode, and if the buffer : 
; soe 026 ! is not empty, do a WRITELN. : 
i 0264 te ; 
; 204 0265 : 3 
: 205 0266 § IF .FCB CFCBS$V_TEXT] AND .FCB CFCB$V_GENERATION] AND : 
: 201 8 of - hess CFCBSA_RECORD_CUR] GTRA .FCB CFCBSA_RECORD_BEG)) ; 
: 208 0269 PASSSWRITELN (PFV CPFVSR_PFV], FCB CFCBSR_FCBI); | ; 
; 209 gsi a Bs 3 
: ott 0573 I concet Lazy lookahead i | 
; ! Cancel any Lazy lookahead in progress. . 
: Ble O58 $i eee ee 
3 21 0274 2 ; 
> 214 0275 2 FCB CFCB$V_LAZY) = 0; : 
ee 4b, 0276 2 : 
$18 $558 $ ict RABSV_N hich h b by PAS$GET oc 
H ! Clear V_NLK which may have been set A UNLOCK. : 
: 518 0279 in F : 
; 219 0280 : 
; 220 0281 2 RAB CRABSV_NLK] = 0; $ 
3s gel pce 2 3 
; 222 0283 2 1+ 3 
3 dee 0284 2 ! Is the device a file oriented device and not process-permanent? : 
> 224 0285 2 ' If so, proceed with rewind. $ 
; 225 0286 2 !- 3 
: 226 0287 2 3 
3; der 0288 2 IF .FCB CFCBSV_FODJ] AND NOT .NAM CNAMSV_PPF] ; 
; 228 0289 ; THE $ 
3: ey 0290 BEGIN : 
; 230 0291 ; : 
: 25) 0292 '+ F 
3. 23e 0293 3 ! If this is a sequent tet organization file, we rewind and truncate. ; 
3; 39 0294 3 ! For relative and indexed organizations, we must rewind and delete ; 
: 234 0295 3 ' every record. 3 
3s @59 0296 3 !- : 
: 236 0297 ; $ 
Fe + ha 0298 RAB CRABSB_RAC] = RABSC_SEQ; ! Set sequential access : 
is 238 0299 3 RAB CRABSB_KRFJ) = 0; ! Rewind primary key if indexed : 
|: $20 $300 4 on SPASSRMS_OP (S$REWIND (RAB=.RAB) ) : 
; 241 S44 IF .RAB CRAB$L_STS] NEQ RMS$_IOP AND ! Inappropriate operation 3 
; Zhe 030 ~RAB CRABSL~STS] NEQ RMS$_EOF AND i End of file ; 
3 oF Bane oe RAB$L_STS] NEQ RMS$_BOF ! Already at beginning of file : 
$ sis 0306 SPASSIO_ERROR (PASS$_ERRDURREW) ; ! Error during REWRITE 3 
; 246 0307 : 
; 247 0308 '¢ : : 3 
i 248 0309 ! The file is now rewound. If we got RMS$_I0P, there's nothing 3 
; 249 0310 ! more we need to do. Otherwise, split on the tile organization ; 
3 $20 bai) to either truncate the file or delete all records. : 
i; 252 031 : 


— 


——— 


| 
| 
| 
| 
| 


records. 


'¢ 
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004 PASSPEWR TES - REWRITE procedure 12-Sep-1984 95:94:98 PASRTL. RCIPASREWRIT 
53 0 14 : IF .RAB CRABSL_STS] NEQ RMS$_IOP 
54 15 THEN 
55 0 18 4 BEGIN 
56 0317 4 + 
ef 8 \8 ? Split depending on file organization 
59 0320 4 If .FAB CFABSB_ORG] EQL FABSC_SEQ ! Sequential 
60 t 1 4 THEN 
61 0 ¢ 5 BEGIN 
o¢ 03 6 IF NOT SPASSRMS_OP ($GET (RAB=.RAB)) ! Read first record, if any 
6 0324 5 THEN 
64 B3 5 6 BEGIN : 
o? 4 $ 6 IF .RAB CRABSL_STS] NEQ RMS$_EOF ! End of file? 
seo $358 ¢ SPASSIO_ERROR (PAS$_ERRDURREW); ! Error during REWRITE 
268 O383 6 
269 0330 5 ELSE 
270 0331 6 BEGIN 
271 Oee6 6 '+ 
272 0333 6 ! GET succeeded. Do a STRUNCATE. 
273 0334 6 le 
274 0335 6 
$2 Ste [ IF NOT SPAS$SRMS_OP ($TRUNCATE (RAB=.RAB) ) 
277 0338 6 SPAS$IO_ERROR (PASS$_ERRDURREW); ! Error during REWRITE 
278 0339 6 
279 0340 5 END; 
280 0341 5 
281 Beg 5 14 
282 0345 5 ! So far, all we've done is set the end-of-file mark to the 
283 0344 5 1 ep of the file. The allocated space is still there. 
284 0345 5 ! Set FABSV_TEF so that all unused allocated space will be 
285 0346 5 ' returned when the file is closed. 
286 0347 5 le 
287 0348 5 
285 0349 5 FAB CFABSV_TEF] = 1; 
289 0350 5 
290 0351 5 END 
291 b326 6 ELSE 
$36 353 5 BEGIN 
29 0354 5 + i 
294 0355 5 ' Relative and Indexed organizations. Get and Delete all 
95 0356 5 
0357 5 
0358 5 
0359 5 ; } ’ 
0360 5 ! Do an initial $GET to see if the file is empty. 
0361 5 le 
8306 5 
036 g IF NOT $SPASSRMS_OP ($GET (RAB=.RAB)) 
0364 THEN 
0365 6 BEGIN 
8306 6 '¢ ' 
367 6 ! If file is empty. then don't do an Ching else. 
0368 6 ! Otherwise, we'll have to require that the user have 
ha ° ' exclusive access to the file. 
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Rey PASSREWRITES ~- REWRITE procedure 12=868-1 382 95:07:98 PASRTL. RCIPASREWRIT.B 231 ’ (3) 

is; 310 0371 6 : 

a \} 8 if e IF .RAB CRABSL_STS] NEQ RMS$_EOF : 
3 18 Behe 2 SPASSIO_ERROR (PAS$_ERRDURREW); ! Error during REWRITE ; 
3; 315 0376 5 ELSE : 

3 316 0377 6 BEGIN ; 
: 17 0378 6 1+ : 
; 318 0379 6 ! We can only scratch the data in the file if we have exclusive : 
; 233 p80 6 ! access to it. If not, give an error : 
:; 320 0381 6 le : 
3 $53 O86 6 3 
; $§ b387 ? IF NOT .FAB CFABSV_NILJ 3 

| 3 352 0385 6 SPASSIO_ERROR (PASS_REWNOTALL); ! REWRITE not allowed : 
3 Deo 0386 6 : 
; 326 0387 6 WHILE 1 DO : 
; ae! 0388 7 3 
; 328 0389 8 IF NOT SPASSRMS_OP (S$DELETE (RAB=.RAB)) ; 
$s Bey 0390 7 THEN : 
; 330 0391 7 SPASSIO_ERROR (PAS$_ERRDURREW) ; ! Error during REWRITE 3 
oe +) O88 8 IF NOT $PASSRMS_OP ($GET (RAB=.RAB) ) : 
; gee 0393 7 THEN ; 
s Bop 0394 8 BEGIN : 
; 334 0395 8 IF .RAB CRABSL_STS] EQL RMS$_EOF ; 
; 335 0396 8 : 
; 33 0397 8 EXITLOOP : 
3 Sor 0398 8 ; 
: 328 0399 8 SPASSIO_ERROR (PAS$_ERRDURREW); ! Error during REWRITE : 
3 So 0400 7 END; | : 
; 340 0401 6 END; : 
; «341 0402 5 END; ; 
; 342 0403 4 END; | : 
; 343 0404 3 END; : 
> 344 0405 3 : 
; 345 0406 3 4 ; 
; 346 0407 3 ! Rewind again to put us at the beginning. : 
; 34? 0408 3 _= : 
: 348 0409 3 : 
i: 349 0410 3 SPASSRMS_OP (SREWIND (RAB=.RAB)); ! Ignore return status 3 
; Zoe 0411 2 END: : 
gs wl pele 2 : 
3 62 0413 2 ‘+ : 
; 353 0414 $ ! Set Generation mede. Reset buffer pointers. : 
; 354 0415 ! Set ‘‘truncate-on-put" so that first SPUT will succeed to a magtape. : 
; 355 0416 ! An RMS restriction prevents aryreery SPUTs from succeeding if the : 
: 356 0417 ; saqtape file is empty. This bit will be cleared after the first 3 
; $20 0418 ! $PUT. It is ignored for non-sequential $PUTs. : 
3 328 0419 te : 
3 399 0420 : 
: 360 0421 FCB CFCBSV_INSPECTION] = 0; : 
: 61 04 5 FCB CFCBSV_GENERATION] = 1; ; 
; 62 04 FCB CFCBSA-RECORD_BEG) = .RAB CRABSL_UBFI; : 
; 36 b4g4 FCB FCBSALRECORD CUR} = [FCB CFCBSA-RECORD_BEG); ; 
> 364 425 FCB CFCBSL-RECORD-LEN) = .RAB CRABS$W-USZ); ; 
; 365 0426 FCB FCBSA"RECORD_ENDJ = .FCB CFCBSA~RECORD_BEG] + .FCB CFCBSL_RECORD_LEN]; ; 
; 366 0427 FCB CFCBS$V_EOF) = 1; : 

| 

| 
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| 
| PASSREWRITE2 = REWRITE procedure Sep-1984 PASRIL” SR yoRgT. 5 2;1 
: 367 04 g FCB CFCBSV_LOCATE) = 0; 
: 368 04 FCB [FCBSV-PARTIAL LINE] = 0; 
: 369 0430 RAB CRABSV-TPT] = 1: 
. on 
Ps '¢ 
: i 04 : ' Undefine the file buffer 
: 7 0434 i Validate the status bits 
: $e 0435 i Indicate successful completion 
b nmnlock the 
75 04 i Unlock the file 
: 38 nt - 
; 378 0439 PFV CPFVSV_EOF DEFINED = 1; 
; 379 0440 PFV CPFVS$V_VALID i 
; 380 0441 PFV CPFV$V-DFBJ = 0; 
; 381 O44e FCB CFCBS$L-STATUSJ = 0; 
; 382 0443 s PFV CPFVSV~LOCK] = 0; 
: eae “¥ | § RETURN; 
; 386 447 1 END; ! End of routine PAS$SREWRITE2 
-TITLE PAS$REWRITE2 REWRITE procedure 
-IDENT \1-004\ 
.EXTRN PASS$REWRITE2, PASS$IO_HANDLER 
SEXTRN PASS$SVALIDATE_PFV 
-EXTRN PASSSOPEN_ IMPLICIT 
.EXTRN PASSSOPEN, PASSS$SIGNAL 
"EXTRN PAS$K_GENNOTALL 
~EXTRN PASSSORITELN, SYSSREWINO 
-EXTRN PAS$K_ERRDUR 
-EXTRN SYSS$GET SY SSTRUNCATE 
“EXTRN PAS$K_REWNOTALL 
.EXTRN SYSSDELETE 
-PSECT _PASSCODE,NOWRT, SHR, PIC,2 
OFFC 00000 ENTRY PASSREWRITE2, Save R2,R3,R4,R5,R6,R7,R8,R9,- 
5B 000000006 00 9€ 00002 MOVAB SYS$REWIND, R11 
5A 000000006 00 9E 00009 MOVAB PASSSSIGNAL , R10 
59 000000006 100 9E 00010 MOVAB SYSS$GET, R9 
5E 98 C2 90017 SUBL2 #8, S 
E D4 OOOIA CLRL. ERROR_ADDR 
04 AE 7C 9901¢ CLRO NWIND ACT 
6D O1CE CF DE OO01F MOVAL 9$ 
02 6C 91 00024 CMPB APS, 
04 1 00027 BLSSU 
6E 08 ac 00 99 9 OVL ERROR, ERROR_ADDR 
56 04 AC 00 0002D 18: MOVL F 
08 AE 56 D0 00031 MOVL 6, PFV_ADDR 
000000006 00 16 00035 JSB PASSSVACIDATE_PFV 
04 01 pd 09 a MOVL #1, UNWIND_ 
5 Ab E 00%F MOVAB 4(R6), RB 
06 2 AB €E8 00043 BLBS 2(R8) 
000000006 00 16 00047 JSB PASSSOPEN_IMPLICIT 
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Rett PASSREWRITE2 = REWRITE procedure 1o-88-13be 95:07:98 LPASRTL SRE PASREWRIT.B32;1 ag! 3 
0B be 1D £0 0004D 2$: BBS #29, (RB), 3$ 1 0249. 
04 DD 0005 PUSHL #4 > 0251 
$ DD 903 PUSHL RS : 
000000006 09 FB 0005 CALLS #2, PASSSOPEN : 
OA Fa 4 €1 0005C 3s: BBC #4. -B(FCB), 4$ + 0257. 
E D4 00061 CLRL = = ( §P) + 0259 | 
7E 00G 8F 9A 0063 MOVZBL #PASS$K_GENNOTALL, -(SP) : | 
6A 02 FB 90067 CALLS #2, PASSS$SIGNAL ; | 
1 FB AT SOE So0Ge 4$: BLBC 8 ¢F cB) 5$ + 0266. 
OD FD OA 04 €1 000eF BBC #4, -3(FCB), 5$ : 
EB A? EC Ay D1 00074 CMPL © =20( FCB), -24(FCB) ; 0267 
06 1B 00079 BLEGU 5$ ; | 
000000006 00 16 00078 JSB PASSS$WRITELN > 0269 | 
52 FC A? QE 00081 5$ MOVAB =4(FCB), R2 + 0275 
01 A2 04 8A 00085 BICB2 #4, 1(R3) : 
06 A? 10 8A 00089 BICB2 #16, 6(FCB) + 0281 | 
03 03 A2 Es 0008D LBS  3(R2), 7$ : 0288 | 
0120 31 00091 6$: BRW 28$ ; 
FS OOCA C7 EB 00094 7$: BLBS e02(F CB), 64 : 
1E A? 94 00099 CLRB O(FCB) : 0298 
35 AZ 94 0009C CLRB =: 55 3( FCB) + 0299 
57 DD OO009F 8 PUSHL FCB : 0300) 
68 01 FB O00A1 CALLS #1, SYSSREWIND : 
2E 50 €8 OOOA4 BLBS  $$STATUS, 10$ ; 
0001825A SF 50 D1 000A7 CMPL $$STATUS. #98906 ; 
04 12 OOOAE BNEQ 9S ; | 
EB 03 A2 €8 00080 BLBS  3(R2), 8$ ; | 
1E 50 E8 00084 9$ BLBS  $$STATUS, 10$ ; 
00018574 8F 08 A7 D1 00087 CMPL  8(FCB), #99700 > 0302 | 
14 13 O00BF BEQL 10$ ; 
0001827A BF 08 A7 01 000C1 CMPL  8(FCB), #98938 : 0303 
0A 13 000C9 BEQL 10$ ; 
00018198  8F 08 A7 01 0008 CMPL 8 (FCB), #98712 + 0304 
77 +12 000d BNEQ 19$ : | 
00018574 8F 08 A7 D1 00005 108 CMPL  8(FCB), #99700 > 0314 
6B 13 000DD BEQL 18% ; 
61 AZ 95 OO0DF TSTB =: 97 (FCB) : 0320 
46 12 000E2 BNEQ 16$ ; 
57 DD OOOE, 11$:  PUSHL FCB : 0323) 
69 01 FB OO00E6 CALLS #1, SYS$GET : 
iC 50 £8 O00E9 BLBS $$STATUS, 13$ ; 
0001825A BF 5A D1 OOOEC CMPL  $$STATUS. #98906 : 
us if OO0F 3 BNEQ 12$ : 
EB 03 A2 E OOF BLBS  3(R2), 11$ ; 
0c 50 €8 000F9 12$:  BLBS  $$STATUS, 13$ ; | 
0001827A BF 08 A7 D1 O00FC CMPL 8(FCB), #98938 ; 0326 | 
1E 13 00104 BEQL 15$ ; | 
44 11 00106 BRB 19$ : 0328 | 
57 DD 00108 13$ PUSHL FCB : 0336. 
000000006 00 01 FB 010A CALLS #1, SYSS$TRUNCATE ; 
10 50 €8 00111 BLBS  $$STATUS, ; | 
0001825A &F 50 01 OO114 CMPL  $$STATUS. #98906 : | 
04 1 118 BNEQ 143 : 
e7 03 a3 E 00110 BLBS  3(R2), 13$ ; 
3 50 € 12) 14$: LBC $$STATUS, 25$ ; 
4B A? 10 68 00124 15$:  BISB2 #16, 75(FCB) ; 0349 
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; Routine Size: 532 bytes, Routine Base: 


: 3B7 0448 1 
0449 1 !<BLF/PAGE> 


st - 
Sep- 


1982 98:54:58 


PUSHAB 
P 


AX-11 BLi fees 32 ye 05 hs 
PASRTL.SRCJPASREWRIT.B52;1 
UNWIND_ACT 

PFV_ADDR 


SP 
4(AP), =(SP) 
#3, PAs$sio HANDLER 
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! End of module PASS$REWRITE2 


PSECT SUMMARY 
Attributes 
32 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 


Library Statistics 


ASSREWRITE2 REWRITE procedure 
-004 e 
90 0450 1 END 
91 0451 1 
92 0452 0 ELUDOM 
Name By 
_PASSCODE 
File 


-$255$DUA28: EH ge SR L32; 
~$255$DUA28: CPASRTL .OBJ JPASLIB.L 


BLESS/CHE CROCE SELB, INE TEAL OPT IMS ZE )/MOTRACE/LIS=1 15S PASREURIT/OB)90BI8 :PASREURIT MSRC$:PASREWRIT/UPDATE=(ENHS:PASREWRIT 


Size: 532 code + 0 data b 
Run Time: 00:13.1 
Elapsed Time: 00:48.9 
Lines/CPU Min: 2067 
,ovemne/ Suita: 21736 

pee | Used: 210 pages 
Compilation Complete 


1 
32;1 


ytes 


Ean Symbols -------- Pages Processing 

Total Loaded Percent Mapped Time 

9776 ea 0 581 00:01.0 
427 100 23 33 00:00.4 
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AX-11 Bliss-32 V4.0 
PASRTL.SRC PASREWRIT. if 231 


AH-BT13A-SE 
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VAX/VMS V4.0 ___CONFID 
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